!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Generate the atomic neighbor lists.
!> \par History
!>      - List rebuild for sab_orb neighbor list (10.09.2002,MK)
!>      - List rebuild for all lists (25.09.2002,MK)
!>      - Row-wise parallelized version (16.06.2003,MK)
!>      - Row- and column-wise parallelized version (19.07.2003,MK)
!>      - bug fix for non-periodic case (23.02.06,MK)
!>      - major refactoring (25.07.10,jhu)
!> \author Matthias Krack (08.10.1999,26.03.2002,16.06.2003)
! **************************************************************************************************
MODULE qs_neighbor_lists
   USE almo_scf_types,                  ONLY: almo_max_cutoff_multiplier
   USE atomic_kind_types,               ONLY: atomic_kind_type,&
                                              get_atomic_kind,&
                                              get_atomic_kind_set
   USE basis_set_types,                 ONLY: get_gto_basis_set,&
                                              gto_basis_set_p_type,&
                                              gto_basis_set_type
   USE cell_types,                      ONLY: cell_type,&
                                              get_cell,&
                                              pbc,&
                                              plane_distance,&
                                              real_to_scaled,&
                                              scaled_to_real
   USE cp_control_types,                ONLY: dft_control_type
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_type
   USE cp_output_handling,              ONLY: cp_p_file,&
                                              cp_print_key_finished_output,&
                                              cp_print_key_should_output,&
                                              cp_print_key_unit_nr
   USE cp_units,                        ONLY: cp_unit_from_cp2k
   USE distribution_1d_types,           ONLY: distribution_1d_type
   USE distribution_2d_types,           ONLY: distribution_2d_type
   USE ewald_environment_types,         ONLY: ewald_env_get,&
                                              ewald_environment_type
   USE external_potential_types,        ONLY: all_potential_type,&
                                              get_potential,&
                                              gth_potential_type,&
                                              sgp_potential_type
   USE input_constants,                 ONLY: &
        dispersion_uff, do_method_lrigpw, do_method_rigpw, do_potential_id, do_potential_short, &
        do_potential_truncated, do_se_IS_slater, vdw_pairpot_dftd3, vdw_pairpot_dftd3bj, &
        xc_vdw_fun_pairpot
   USE input_section_types,             ONLY: section_vals_get,&
                                              section_vals_get_subs_vals,&
                                              section_vals_type,&
                                              section_vals_val_get
   USE kinds,                           ONLY: default_string_length,&
                                              dp,&
                                              int_8
   USE kpoint_types,                    ONLY: kpoint_type
   USE libint_2c_3c,                    ONLY: cutoff_screen_factor
   USE mathlib,                         ONLY: erfc_cutoff
   USE message_passing,                 ONLY: mp_para_env_type
   USE molecule_types,                  ONLY: molecule_type
   USE particle_types,                  ONLY: particle_type
   USE paw_proj_set_types,              ONLY: get_paw_proj_set,&
                                              paw_proj_set_type
   USE periodic_table,                  ONLY: ptable
   USE physcon,                         ONLY: bohr
   USE qs_dftb_types,                   ONLY: qs_dftb_atom_type
   USE qs_dftb_utils,                   ONLY: get_dftb_atom_param
   USE qs_dispersion_types,             ONLY: qs_dispersion_type
   USE qs_environment_types,            ONLY: get_qs_env,&
                                              qs_environment_type
   USE qs_gcp_types,                    ONLY: qs_gcp_type
   USE qs_kind_types,                   ONLY: get_qs_kind,&
                                              get_qs_kind_set,&
                                              qs_kind_type
   USE qs_ks_types,                     ONLY: get_ks_env,&
                                              qs_ks_env_type,&
                                              set_ks_env
   USE qs_neighbor_list_types,          ONLY: &
        add_neighbor_list, add_neighbor_node, allocate_neighbor_list_set, get_iterator_info, &
        get_iterator_task, neighbor_list_iterate, neighbor_list_iterator_create, &
        neighbor_list_iterator_p_type, neighbor_list_iterator_release, neighbor_list_p_type, &
        neighbor_list_set_p_type, neighbor_list_set_type, release_neighbor_list_sets
   USE string_utilities,                ONLY: compress,&
                                              uppercase
   USE subcell_types,                   ONLY: allocate_subcell,&
                                              deallocate_subcell,&
                                              give_ijk_subcell,&
                                              subcell_type
   USE util,                            ONLY: locate,&
                                              sort
   USE xtb_types,                       ONLY: get_xtb_atom_param,&
                                              xtb_atom_type
#include "./base/base_uses.f90"

   IMPLICIT NONE

   PRIVATE

! **************************************************************************************************
   TYPE local_atoms_type
      INTEGER, DIMENSION(:), POINTER                   :: list => NULL(), &
                                                          list_local_a_index => NULL(), &
                                                          list_local_b_index => NULL(), &
                                                          list_1d => NULL(), &
                                                          list_a_mol => NULL(), &
                                                          list_b_mol => NULL()
   END TYPE local_atoms_type
! **************************************************************************************************

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_neighbor_lists'

   ! private counter, used to version qs neighbor lists
   INTEGER, SAVE, PRIVATE :: last_qs_neighbor_list_id_nr = 0

   ! Public subroutines
   PUBLIC :: build_qs_neighbor_lists, local_atoms_type, atom2d_cleanup, &
             atom2d_build, build_neighbor_lists, pair_radius_setup, &
             setup_neighbor_list, write_neighbor_lists
CONTAINS

! **************************************************************************************************
!> \brief   free the internals of atom2d
!> \param atom2d ...
!> \param
! **************************************************************************************************
   SUBROUTINE atom2d_cleanup(atom2d)
      TYPE(local_atoms_type), DIMENSION(:)               :: atom2d

      CHARACTER(len=*), PARAMETER                        :: routineN = 'atom2d_cleanup'

      INTEGER                                            :: handle, ikind

      CALL timeset(routineN, handle)
      DO ikind = 1, SIZE(atom2d)
         NULLIFY (atom2d(ikind)%list)
         IF (ASSOCIATED(atom2d(ikind)%list_local_a_index)) THEN
            DEALLOCATE (atom2d(ikind)%list_local_a_index)
         END IF
         IF (ASSOCIATED(atom2d(ikind)%list_local_b_index)) THEN
            DEALLOCATE (atom2d(ikind)%list_local_b_index)
         END IF
         IF (ASSOCIATED(atom2d(ikind)%list_a_mol)) THEN
            DEALLOCATE (atom2d(ikind)%list_a_mol)
         END IF
         IF (ASSOCIATED(atom2d(ikind)%list_b_mol)) THEN
            DEALLOCATE (atom2d(ikind)%list_b_mol)
         END IF
         IF (ASSOCIATED(atom2d(ikind)%list_1d)) THEN
            DEALLOCATE (atom2d(ikind)%list_1d)
         END IF
      END DO
      CALL timestop(handle)

   END SUBROUTINE atom2d_cleanup

! **************************************************************************************************
!> \brief   Build some distribution structure of atoms, refactored from build_qs_neighbor_lists
!> \param atom2d output
!> \param distribution_1d ...
!> \param distribution_2d ...
!> \param atomic_kind_set ...
!> \param molecule_set ...
!> \param molecule_only ...
!> \param particle_set ...
!> \author  JH
! **************************************************************************************************
   SUBROUTINE atom2d_build(atom2d, distribution_1d, distribution_2d, &
                           atomic_kind_set, molecule_set, molecule_only, particle_set)
      TYPE(local_atoms_type), DIMENSION(:)               :: atom2d
      TYPE(distribution_1d_type), POINTER                :: distribution_1d
      TYPE(distribution_2d_type), POINTER                :: distribution_2d
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
      LOGICAL                                            :: molecule_only
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set

      CHARACTER(len=*), PARAMETER                        :: routineN = 'atom2d_build'

      INTEGER                                            :: atom_a, handle, ia, iat, iatom, &
                                                            iatom_local, ikind, imol, natom, &
                                                            natom_a, natom_local_a, natom_local_b, &
                                                            nel, nkind
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: atom2mol, atom_of_kind, listindex, &
                                                            listsort
      INTEGER, DIMENSION(:), POINTER                     :: local_cols_array, local_rows_array

      CALL timeset(routineN, handle)

      nkind = SIZE(atomic_kind_set)
      natom = SIZE(particle_set)
      CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, atom_of_kind=atom_of_kind)

      IF (molecule_only) THEN
         ALLOCATE (atom2mol(natom))
         DO imol = 1, SIZE(molecule_set)
            DO iat = molecule_set(imol)%first_atom, molecule_set(imol)%last_atom
               atom2mol(iat) = imol
            END DO
         END DO
      END IF

      DO ikind = 1, nkind
         NULLIFY (atom2d(ikind)%list)
         NULLIFY (atom2d(ikind)%list_local_a_index)
         NULLIFY (atom2d(ikind)%list_local_b_index)
         NULLIFY (atom2d(ikind)%list_1d)
         NULLIFY (atom2d(ikind)%list_a_mol)
         NULLIFY (atom2d(ikind)%list_b_mol)

         CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom2d(ikind)%list)

         natom_a = SIZE(atom2d(ikind)%list)

         natom_local_a = distribution_2d%n_local_rows(ikind)
         natom_local_b = distribution_2d%n_local_cols(ikind)
         local_rows_array => distribution_2d%local_rows(ikind)%array
         local_cols_array => distribution_2d%local_cols(ikind)%array

         nel = distribution_1d%n_el(ikind)
         ALLOCATE (atom2d(ikind)%list_1d(nel))
         DO iat = 1, nel
            ia = distribution_1d%list(ikind)%array(iat)
            atom2d(ikind)%list_1d(iat) = atom_of_kind(ia)
         END DO

         ALLOCATE (listsort(natom_a), listindex(natom_a))
         listsort(1:natom_a) = atom2d(ikind)%list(1:natom_a)
         CALL sort(listsort, natom_a, listindex)
         ! Block rows
         IF (natom_local_a > 0) THEN
            ALLOCATE (atom2d(ikind)%list_local_a_index(natom_local_a))
            ALLOCATE (atom2d(ikind)%list_a_mol(natom_local_a))
            atom2d(ikind)%list_a_mol(:) = 0

            ! Build index vector for mapping
            DO iatom_local = 1, natom_local_a
               atom_a = local_rows_array(iatom_local)
               iatom = locate(listsort, atom_a)
               atom2d(ikind)%list_local_a_index(iatom_local) = listindex(iatom)
               IF (molecule_only) atom2d(ikind)%list_a_mol(iatom_local) = atom2mol(atom_a)
            END DO

         END IF

         ! Block columns
         IF (natom_local_b > 0) THEN

            ALLOCATE (atom2d(ikind)%list_local_b_index(natom_local_b))
            ALLOCATE (atom2d(ikind)%list_b_mol(natom_local_b))
            atom2d(ikind)%list_b_mol(:) = 0

            ! Build index vector for mapping
            DO iatom_local = 1, natom_local_b
               atom_a = local_cols_array(iatom_local)
               iatom = locate(listsort, atom_a)
               atom2d(ikind)%list_local_b_index(iatom_local) = listindex(iatom)
               IF (molecule_only) atom2d(ikind)%list_b_mol(iatom_local) = atom2mol(atom_a)
            END DO

         END IF

         DEALLOCATE (listsort, listindex)

      END DO

      CALL timestop(handle)

   END SUBROUTINE atom2d_build

! **************************************************************************************************
!> \brief   Build all the required neighbor lists for Quickstep.
!> \param qs_env ...
!> \param para_env ...
!> \param molecular ...
!> \param force_env_section ...
!> \date    28.08.2000
!> \par History
!>          - Major refactoring (25.07.2010,jhu)
!> \author  MK
!> \version 1.0
! **************************************************************************************************
   SUBROUTINE build_qs_neighbor_lists(qs_env, para_env, molecular, force_env_section)
      TYPE(qs_environment_type), POINTER                 :: qs_env
      TYPE(mp_para_env_type), POINTER                    :: para_env
      LOGICAL, OPTIONAL                                  :: molecular
      TYPE(section_vals_type), POINTER                   :: force_env_section

      CHARACTER(len=*), PARAMETER :: routineN = 'build_qs_neighbor_lists'

      CHARACTER(LEN=2)                                   :: element_symbol, element_symbol2
      CHARACTER(LEN=default_string_length)               :: print_key_path
      INTEGER                                            :: handle, hfx_pot, ikind, ingp, iw, jkind, &
                                                            maxatom, ngp, nkind, zat
      LOGICAL :: all_potential_present, almo, dftb, do_hfx, dokp, gth_potential_present, &
         lri_optbas, lrigpw, mic, molecule_only, nddo, paw_atom, paw_atom_present, rigpw, &
         sgp_potential_present, xtb
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: all_present, aux_fit_present, aux_present, &
         core_present, default_present, nonbond1_atom, nonbond2_atom, oce_present, orb_present, &
         ppl_present, ppnl_present, ri_present, xb1_atom, xb2_atom
      REAL(dp)                                           :: almo_rcov, almo_rvdw, eps_schwarz, &
                                                            omega, pdist, rcut, roperator, subcells
      REAL(dp), ALLOCATABLE, DIMENSION(:) :: all_pot_rad, aux_fit_radius, c_radius, calpha, &
         core_radius, oce_radius, orb_radius, ppl_radius, ppnl_radius, ri_radius, zeff
      REAL(dp), ALLOCATABLE, DIMENSION(:, :)             :: pair_radius, pair_radius_lb
      TYPE(all_potential_type), POINTER                  :: all_potential
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(cell_type), POINTER                           :: cell
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dft_control_type), POINTER                    :: dft_control
      TYPE(distribution_1d_type), POINTER                :: distribution_1d
      TYPE(distribution_2d_type), POINTER                :: distribution_2d
      TYPE(ewald_environment_type), POINTER              :: ewald_env
      TYPE(gth_potential_type), POINTER                  :: gth_potential
      TYPE(gto_basis_set_type), POINTER                  :: aux_basis_set, aux_fit_basis_set, &
                                                            orb_basis_set, ri_basis_set
      TYPE(kpoint_type), POINTER                         :: kpoints
      TYPE(local_atoms_type), ALLOCATABLE, DIMENSION(:)  :: atom2d
      TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
      TYPE(neighbor_list_set_p_type), DIMENSION(:), POINTER :: saa_list, sab_all, sab_almo, &
         sab_cn, sab_core, sab_gcp, sab_kp, sab_kp_nosym, sab_lrc, sab_orb, sab_scp, sab_se, &
         sab_tbe, sab_vdw, sab_xb, sab_xtb_nonbond, sab_xtbe, sac_ae, sac_lri, sac_ppl, sap_oce, &
         sap_ppnl, soa_list, soo_list
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(paw_proj_set_type), POINTER                   :: paw_proj
      TYPE(qs_dftb_atom_type), POINTER                   :: dftb_atom
      TYPE(qs_dispersion_type), POINTER                  :: dispersion_env
      TYPE(qs_gcp_type), POINTER                         :: gcp_env
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(qs_ks_env_type), POINTER                      :: ks_env
      TYPE(section_vals_type), POINTER                   :: hfx_sections, neighbor_list_section
      TYPE(sgp_potential_type), POINTER                  :: sgp_potential
      TYPE(xtb_atom_type), POINTER                       :: xtb_atom

      CALL timeset(routineN, handle)
      NULLIFY (logger)
      logger => cp_get_default_logger()

      NULLIFY (atomic_kind_set, qs_kind_set, cell, neighbor_list_section, &
               distribution_1d, distribution_2d, gth_potential, sgp_potential, orb_basis_set, &
               particle_set, molecule_set, dft_control, ks_env)

      NULLIFY (sab_orb)
      NULLIFY (sac_ae)
      NULLIFY (sac_ppl)
      NULLIFY (sac_lri)
      NULLIFY (sap_ppnl)
      NULLIFY (sap_oce)
      NULLIFY (sab_se)
      NULLIFY (sab_lrc)
      NULLIFY (sab_tbe)
      NULLIFY (sab_xtbe)
      NULLIFY (sab_core)
      NULLIFY (sab_xb)
      NULLIFY (sab_xtb_nonbond)
      NULLIFY (sab_all)
      NULLIFY (sab_vdw)
      NULLIFY (sab_cn)
      NULLIFY (soo_list)
      NULLIFY (sab_scp)
      NULLIFY (sab_almo)
      NULLIFY (sab_kp)
      NULLIFY (sab_kp_nosym)

      CALL get_qs_env(qs_env, &
                      ks_env=ks_env, &
                      atomic_kind_set=atomic_kind_set, &
                      qs_kind_set=qs_kind_set, &
                      cell=cell, &
                      kpoints=kpoints, &
                      distribution_2d=distribution_2d, &
                      local_particles=distribution_1d, &
                      particle_set=particle_set, &
                      molecule_set=molecule_set, &
                      dft_control=dft_control)

      neighbor_list_section => section_vals_get_subs_vals(force_env_section, "DFT%PRINT%NEIGHBOR_LISTS")

      ! This sets the id number of the qs neighbor lists, new lists, means new version
      ! new version implies new sparsity of the matrices
      last_qs_neighbor_list_id_nr = last_qs_neighbor_list_id_nr + 1
      CALL set_ks_env(ks_env=ks_env, neighbor_list_id=last_qs_neighbor_list_id_nr)

      CALL get_ks_env(ks_env=ks_env, &
                      sab_orb=sab_orb, &
                      sac_ae=sac_ae, &
                      sac_ppl=sac_ppl, &
                      sac_lri=sac_lri, &
                      sab_vdw=sab_vdw, &
                      sap_ppnl=sap_ppnl, &
                      sap_oce=sap_oce, &
                      sab_se=sab_se, &
                      sab_lrc=sab_lrc, &
                      sab_tbe=sab_tbe, &
                      sab_xtbe=sab_xtbe, &
                      sab_core=sab_core, &
                      sab_xb=sab_xb, &
                      sab_xtb_nonbond=sab_xtb_nonbond, &
                      sab_scp=sab_scp, &
                      sab_all=sab_all, &
                      sab_almo=sab_almo, &
                      sab_kp=sab_kp, &
                      sab_kp_nosym=sab_kp_nosym)

      dokp = (kpoints%nkp > 0)
      nddo = dft_control%qs_control%semi_empirical
      dftb = dft_control%qs_control%dftb
      xtb = dft_control%qs_control%xtb
      almo = dft_control%qs_control%do_almo_scf
      lrigpw = (dft_control%qs_control%method_id == do_method_lrigpw)
      rigpw = (dft_control%qs_control%method_id == do_method_rigpw)
      lri_optbas = dft_control%qs_control%lri_optbas

      ! molecular lists
      molecule_only = .FALSE.
      IF (PRESENT(molecular)) molecule_only = molecular
      ! minimum image convention (MIC)
      mic = molecule_only
      IF (dokp) THEN
         ! no MIC for kpoints
         mic = .FALSE.
      ELSEIF (nddo) THEN
         ! enforce MIC for interaction lists in SE
         mic = .TRUE.
      END IF
      pdist = dft_control%qs_control%pairlist_radius

      hfx_sections => section_vals_get_subs_vals(qs_env%input, "DFT%XC%HF")
      CALL section_vals_get(hfx_sections, explicit=do_hfx)

      CALL get_atomic_kind_set(atomic_kind_set, maxatom=maxatom)
      CALL get_qs_kind_set(qs_kind_set, paw_atom_present=paw_atom_present, &
                           gth_potential_present=gth_potential_present, &
                           sgp_potential_present=sgp_potential_present, &
                           all_potential_present=all_potential_present)

      CALL section_vals_val_get(qs_env%input, "DFT%SUBCELLS", r_val=subcells)

      ! Allocate work storage
      nkind = SIZE(atomic_kind_set)
      ALLOCATE (orb_present(nkind), aux_fit_present(nkind), aux_present(nkind), &
                default_present(nkind), core_present(nkind))
      ALLOCATE (orb_radius(nkind), aux_fit_radius(nkind), c_radius(nkind), &
                core_radius(nkind), calpha(nkind), zeff(nkind))
      orb_radius(:) = 0.0_dp
      aux_fit_radius(:) = 0.0_dp
      c_radius(:) = 0.0_dp
      core_radius(:) = 0.0_dp
      calpha(:) = 0.0_dp
      zeff(:) = 0.0_dp

      ALLOCATE (pair_radius(nkind, nkind))
      IF (gth_potential_present .OR. sgp_potential_present) THEN
         ALLOCATE (ppl_present(nkind), ppl_radius(nkind))
         ppl_radius = 0.0_dp
         ALLOCATE (ppnl_present(nkind), ppnl_radius(nkind))
         ppnl_radius = 0.0_dp
      END IF
      IF (paw_atom_present) THEN
         ALLOCATE (oce_present(nkind), oce_radius(nkind))
         oce_radius = 0.0_dp
      END IF
      IF (all_potential_present .OR. sgp_potential_present) THEN
         ALLOCATE (all_present(nkind), all_pot_rad(nkind))
         all_pot_rad = 0.0_dp
      END IF

      ! Initialize the local data structures
      ALLOCATE (atom2d(nkind))
      CALL atom2d_build(atom2d, distribution_1d, distribution_2d, atomic_kind_set, &
                        molecule_set, molecule_only, particle_set=particle_set)

      DO ikind = 1, nkind

         CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom2d(ikind)%list)

         CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, basis_type="ORB")
         CALL get_qs_kind(qs_kind_set(ikind), basis_set=aux_basis_set, basis_type="AUX")
         CALL get_qs_kind(qs_kind_set(ikind), basis_set=aux_fit_basis_set, basis_type="AUX_FIT")

         CALL get_qs_kind(qs_kind_set(ikind), &
                          paw_proj_set=paw_proj, &
                          paw_atom=paw_atom, &
                          all_potential=all_potential, &
                          gth_potential=gth_potential, &
                          sgp_potential=sgp_potential)

         IF (dftb) THEN
            ! Set the interaction radius for the neighbor lists (DFTB case)
            ! This includes all interactions (orbitals and short range pair potential) except vdW
            CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom)
            CALL get_dftb_atom_param(dftb_parameter=dftb_atom, &
                                     cutoff=orb_radius(ikind), &
                                     defined=orb_present(ikind))
         ELSE
            IF (ASSOCIATED(orb_basis_set)) THEN
               orb_present(ikind) = .TRUE.
               CALL get_gto_basis_set(gto_basis_set=orb_basis_set, kind_radius=orb_radius(ikind))
            ELSE
               orb_present(ikind) = .FALSE.
            END IF
         END IF

         IF (ASSOCIATED(aux_basis_set)) THEN
            aux_present(ikind) = .TRUE.
         ELSE
            aux_present(ikind) = .FALSE.
         END IF

         IF (ASSOCIATED(aux_fit_basis_set)) THEN
            aux_fit_present(ikind) = .TRUE.
            CALL get_gto_basis_set(gto_basis_set=aux_fit_basis_set, kind_radius=aux_fit_radius(ikind))
         ELSE
            aux_fit_present(ikind) = .FALSE.
         END IF

         ! core overlap
         CALL get_qs_kind(qs_kind_set(ikind), &
                          alpha_core_charge=calpha(ikind), &
                          core_charge_radius=core_radius(ikind), &
                          zeff=zeff(ikind))
         IF (zeff(ikind) /= 0._dp .AND. calpha(ikind) /= 0._dp) THEN
            core_present(ikind) = .TRUE.
         ELSE
            core_present(ikind) = .FALSE.
         END IF

         ! Pseudopotentials
         IF (gth_potential_present .OR. sgp_potential_present) THEN
            IF (ASSOCIATED(gth_potential)) THEN
               CALL get_potential(potential=gth_potential, &
                                  ppl_present=ppl_present(ikind), &
                                  ppl_radius=ppl_radius(ikind), &
                                  ppnl_present=ppnl_present(ikind), &
                                  ppnl_radius=ppnl_radius(ikind))
            ELSE IF (ASSOCIATED(sgp_potential)) THEN
               CALL get_potential(potential=sgp_potential, &
                                  ppl_present=ppl_present(ikind), &
                                  ppl_radius=ppl_radius(ikind), &
                                  ppnl_present=ppnl_present(ikind), &
                                  ppnl_radius=ppnl_radius(ikind))
            ELSE
               ppl_present(ikind) = .FALSE.
               ppnl_present(ikind) = .FALSE.
            END IF
         END IF

         ! GAPW
         IF (paw_atom_present) THEN
            IF (paw_atom) THEN
               oce_present(ikind) = .TRUE.
               CALL get_paw_proj_set(paw_proj_set=paw_proj, rcprj=oce_radius(ikind))
            ELSE
               oce_present(ikind) = .FALSE.
            END IF
         END IF

         ! Check the presence of an all electron potential or ERFC potential
         IF (all_potential_present .OR. sgp_potential_present) THEN
            all_present(ikind) = .FALSE.
            all_pot_rad(ikind) = 0.0_dp
            IF (ASSOCIATED(all_potential)) THEN
               all_present(ikind) = .TRUE.
               CALL get_potential(potential=all_potential, core_charge_radius=all_pot_rad(ikind))
            ELSE IF (ASSOCIATED(sgp_potential)) THEN
               IF (sgp_potential%ecp_local) THEN
                  all_present(ikind) = .TRUE.
                  CALL get_potential(potential=sgp_potential, core_charge_radius=all_pot_rad(ikind))
               END IF
            END IF
         END IF

      END DO

      ! Build the orbital-orbital overlap neighbor lists
      IF (pdist < 0.0_dp) THEN
         pdist = MAX(plane_distance(1, 0, 0, cell), &
                     plane_distance(0, 1, 0, cell), &
                     plane_distance(0, 0, 1, cell))
      END IF
      CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius, pdist)
      CALL build_neighbor_lists(sab_orb, particle_set, atom2d, cell, pair_radius, &
                                mic=mic, subcells=subcells, molecular=molecule_only, nlname="sab_orb")
      CALL set_ks_env(ks_env=ks_env, sab_orb=sab_orb)
      CALL write_neighbor_lists(sab_orb, particle_set, cell, para_env, neighbor_list_section, &
                                "/SAB_ORB", "sab_orb", "ORBITAL ORBITAL")

      ! Build orbital-orbital list containing all the pairs, to be used with
      ! non-symmetric operators. Beware: the cutoff of the orbital-orbital overlap
      ! might not be optimal. It should be verified for each operator.
      IF (.NOT. (nddo .OR. dftb .OR. xtb)) THEN
         CALL build_neighbor_lists(sab_all, particle_set, atom2d, cell, pair_radius, &
                                   mic=mic, symmetric=.FALSE., subcells=subcells, molecular=molecule_only, nlname="sab_all")
         CALL set_ks_env(ks_env=ks_env, sab_all=sab_all)
      END IF

      ! Build the core-core overlap neighbor lists
      IF (.NOT. (nddo .OR. dftb .OR. xtb)) THEN
         CALL pair_radius_setup(core_present, core_present, core_radius, core_radius, pair_radius)
         CALL build_neighbor_lists(sab_core, particle_set, atom2d, cell, pair_radius, subcells=subcells, &
                                   operator_type="PP", nlname="sab_core")
         CALL set_ks_env(ks_env=ks_env, sab_core=sab_core)
         CALL write_neighbor_lists(sab_core, particle_set, cell, para_env, neighbor_list_section, &
                                   "/SAB_CORE", "sab_core", "CORE CORE")
      END IF

      IF (dokp) THEN
         ! We try to guess an integration radius for K-points
         ! For non-HFX calculations we use the overlap list
         ! For HFX we use the interaction radius of kinds (ORB or ADMM basis)
         ! plus a range for the operator
         IF (do_hfx) THEN

            !case study on the HFX potential: TC, SR or Overlap?
            CALL section_vals_val_get(hfx_sections, "INTERACTION_POTENTIAL%POTENTIAL_TYPE", i_val=hfx_pot)

            SELECT CASE (hfx_pot)
            CASE (do_potential_id)
               roperator = 0.0_dp
            CASE (do_potential_truncated)
               CALL section_vals_val_get(hfx_sections, "INTERACTION_POTENTIAL%CUTOFF_RADIUS", r_val=roperator)
            CASE (do_potential_short)
               CALL section_vals_val_get(hfx_sections, "INTERACTION_POTENTIAL%OMEGA", r_val=omega)
               CALL section_vals_val_get(hfx_sections, "SCREENING%EPS_SCHWARZ", r_val=eps_schwarz)
               CALL erfc_cutoff(eps_schwarz, omega, roperator)
            CASE DEFAULT
               CPABORT("HFX potential not available for K-points (NYI)")
            END SELECT

            IF (dft_control%do_admm) THEN
               CALL pair_radius_setup(aux_fit_present, aux_fit_present, aux_fit_radius, aux_fit_radius, &
                                      pair_radius)

               !We cannot accept a pair radius smaller than the ORB overlap, for sanity reasons
               ALLOCATE (pair_radius_lb(nkind, nkind))
               CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius_lb)
               DO jkind = 1, nkind
                  DO ikind = 1, nkind
                     IF (pair_radius(ikind, jkind) + cutoff_screen_factor*roperator .LE. pair_radius_lb(ikind, jkind)) &
                        pair_radius(ikind, jkind) = pair_radius_lb(ikind, jkind) - roperator
                  END DO
               END DO
            ELSE
               CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
            END IF
            pair_radius = pair_radius + cutoff_screen_factor*roperator
         ELSE
            CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
         END IF
         CALL build_neighbor_lists(sab_kp, particle_set, atom2d, cell, pair_radius, &
                                   subcells=subcells, nlname="sab_kp")
         CALL set_ks_env(ks_env=ks_env, sab_kp=sab_kp)

         IF (do_hfx) THEN
            CALL build_neighbor_lists(sab_kp_nosym, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, nlname="sab_kp_nosym", symmetric=.FALSE.)
            CALL set_ks_env(ks_env=ks_env, sab_kp_nosym=sab_kp_nosym)
         END IF
      END IF

      ! Build orbital GTH-PPL operator overlap list
      IF (gth_potential_present .OR. sgp_potential_present) THEN
         IF (ANY(ppl_present)) THEN
            CALL pair_radius_setup(orb_present, ppl_present, orb_radius, ppl_radius, pair_radius)
            CALL build_neighbor_lists(sac_ppl, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="ABC", nlname="sac_ppl")
            CALL set_ks_env(ks_env=ks_env, sac_ppl=sac_ppl)
            CALL write_neighbor_lists(sac_ppl, particle_set, cell, para_env, neighbor_list_section, &
                                      "/SAC_PPL", "sac_ppl", "ORBITAL GTH-PPL")
            IF (lrigpw) THEN
               IF (qs_env%lri_env%ppl_ri) THEN
                  CALL build_neighbor_lists(sac_lri, particle_set, atom2d, cell, pair_radius, &
                                            subcells=subcells, symmetric=.FALSE., operator_type="PP", nlname="sac_lri")
                  CALL set_ks_env(ks_env=ks_env, sac_lri=sac_lri)
               END IF
            END IF
         END IF

         IF (ANY(ppnl_present)) THEN
            CALL pair_radius_setup(orb_present, ppnl_present, orb_radius, ppnl_radius, pair_radius)
            CALL build_neighbor_lists(sap_ppnl, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="ABBA", nlname="sap_ppnl")
            CALL set_ks_env(ks_env=ks_env, sap_ppnl=sap_ppnl)
            CALL write_neighbor_lists(sap_ppnl, particle_set, cell, para_env, neighbor_list_section, &
                                      "/SAP_PPNL", "sap_ppnl", "ORBITAL GTH-PPNL")
         END IF
      END IF

      IF (paw_atom_present) THEN
         ! Build orbital-GAPW projector overlap list
         IF (ANY(oce_present)) THEN
            CALL pair_radius_setup(orb_present, oce_present, orb_radius, oce_radius, pair_radius)
            CALL build_neighbor_lists(sap_oce, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="ABBA", nlname="sap_oce")
            CALL set_ks_env(ks_env=ks_env, sap_oce=sap_oce)
            CALL write_neighbor_lists(sap_oce, particle_set, cell, para_env, neighbor_list_section, &
                                      "/SAP_OCE", "sap_oce", "ORBITAL(A) PAW-PRJ")
         END IF
      END IF

      ! Build orbital-ERFC potential list
      IF (.NOT. (nddo .OR. dftb .OR. xtb)) THEN
         IF (all_potential_present .OR. sgp_potential_present) THEN
            CALL pair_radius_setup(orb_present, all_present, orb_radius, all_pot_rad, pair_radius)
            CALL build_neighbor_lists(sac_ae, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="ABC", nlname="sac_ae")
            CALL set_ks_env(ks_env=ks_env, sac_ae=sac_ae)
            CALL write_neighbor_lists(sac_ae, particle_set, cell, para_env, neighbor_list_section, &
                                      "/SAC_AE", "sac_ae", "ORBITAL ERFC POTENTIAL")
         END IF
      END IF

      IF (nddo) THEN
         ! Semi-empirical neighbor lists
         default_present = .TRUE.
         c_radius = dft_control%qs_control%se_control%cutoff_cou
         ! Build the neighbor lists for the Hartree terms
         CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
         IF (dft_control%qs_control%se_control%do_ewald_gks) THEN
            ! Use MIC for the periodic code of GKS
            CALL build_neighbor_lists(sab_se, particle_set, atom2d, cell, pair_radius, mic=mic, &
                                      subcells=subcells, nlname="sab_se")
         ELSE
            CALL build_neighbor_lists(sab_se, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, nlname="sab_se")
         END IF
         CALL set_ks_env(ks_env=ks_env, sab_se=sab_se)
         CALL write_neighbor_lists(sab_se, particle_set, cell, para_env, neighbor_list_section, &
                                   "/SAB_SE", "sab_se", "HARTREE INTERACTIONS")

         ! If requested build the SE long-range correction neighbor list
         IF ((dft_control%qs_control%se_control%do_ewald) .AND. &
             (dft_control%qs_control%se_control%integral_screening /= do_se_IS_slater)) THEN
            c_radius = dft_control%qs_control%se_control%cutoff_lrc
            CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
            CALL build_neighbor_lists(sab_lrc, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, nlname="sab_lrc")
            CALL set_ks_env(ks_env=ks_env, sab_lrc=sab_lrc)
            CALL write_neighbor_lists(sab_lrc, particle_set, cell, para_env, neighbor_list_section, &
                                      "/SAB_LRC", "sab_lrc", "SE LONG-RANGE CORRECTION")
         END IF
      END IF

      IF (dftb) THEN
         ! Build the neighbor lists for the DFTB Ewald methods
         IF (dft_control%qs_control%dftb_control%do_ewald) THEN
            CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env)
            CALL ewald_env_get(ewald_env, rcut=rcut)
            c_radius = rcut
            CALL pair_radius_setup(orb_present, orb_present, c_radius, c_radius, pair_radius)
            CALL build_neighbor_lists(sab_tbe, particle_set, atom2d, cell, pair_radius, mic=mic, &
                                      subcells=subcells, nlname="sab_tbe")
            CALL set_ks_env(ks_env=ks_env, sab_tbe=sab_tbe)
         END IF

         ! Build the neighbor lists for the DFTB vdW pair potential
         IF (dft_control%qs_control%dftb_control%dispersion) THEN
            IF (dft_control%qs_control%dftb_control%dispersion_type == dispersion_uff) THEN
               DO ikind = 1, nkind
                  CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom)
                  CALL get_dftb_atom_param(dftb_parameter=dftb_atom, rcdisp=c_radius(ikind))
               END DO
               default_present = .TRUE.
               CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
               CALL build_neighbor_lists(sab_vdw, particle_set, atom2d, cell, pair_radius, &
                                         subcells=subcells, nlname="sab_vdw")
               CALL set_ks_env(ks_env=ks_env, sab_vdw=sab_vdw)
            END IF
         END IF
      END IF

      IF (xtb) THEN
         ! Build the neighbor lists for the xTB Ewald method
         IF (dft_control%qs_control%xtb_control%do_ewald) THEN
            CALL get_qs_env(qs_env=qs_env, ewald_env=ewald_env)
            CALL ewald_env_get(ewald_env, rcut=rcut)
            c_radius = rcut
            CALL pair_radius_setup(orb_present, orb_present, c_radius, c_radius, pair_radius)
            CALL build_neighbor_lists(sab_tbe, particle_set, atom2d, cell, pair_radius, mic=mic, &
                                      subcells=subcells, nlname="sab_tbe")
            CALL set_ks_env(ks_env=ks_env, sab_tbe=sab_tbe)
         END IF
         ! SR part of Coulomb interaction
         DO ikind = 1, nkind
            CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom)
            CALL get_xtb_atom_param(xtb_parameter=xtb_atom, rcut=c_radius(ikind))
         END DO
         default_present = .TRUE.
         CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
         CALL build_neighbor_lists(sab_xtbe, particle_set, atom2d, cell, pair_radius, &
                                   subcells=subcells, nlname="sab_xtbe")
         CALL set_ks_env(ks_env=ks_env, sab_xtbe=sab_xtbe)
         ! XB list
         ALLOCATE (xb1_atom(nkind), xb2_atom(nkind))
         c_radius = 0.5_dp*dft_control%qs_control%xtb_control%xb_radius
         DO ikind = 1, nkind
            CALL get_atomic_kind(atomic_kind_set(ikind), z=zat)
            IF (zat == 17 .OR. zat == 35 .OR. zat == 53 .OR. zat == 85) THEN
               xb1_atom(ikind) = .TRUE.
            ELSE
               xb1_atom(ikind) = .FALSE.
            END IF
            IF (zat == 7 .OR. zat == 8 .OR. zat == 15 .OR. zat == 16) THEN
               xb2_atom(ikind) = .TRUE.
            ELSE
               xb2_atom(ikind) = .FALSE.
            END IF
         END DO
         CALL pair_radius_setup(xb1_atom, xb2_atom, c_radius, c_radius, pair_radius)
         CALL build_neighbor_lists(sab_xb, particle_set, atom2d, cell, pair_radius, &
                                   symmetric=.FALSE., subcells=subcells, operator_type="PP", nlname="sab_xb")
         CALL set_ks_env(ks_env=ks_env, sab_xb=sab_xb)
         CALL write_neighbor_lists(sab_xb, particle_set, cell, para_env, neighbor_list_section, &
                                   "/SAB_XB", "sab_xb", "XB bonding")

         ! nonbonded interactions list
         IF (dft_control%qs_control%xtb_control%do_nonbonded) THEN
            ngp = SIZE(dft_control%qs_control%xtb_control%nonbonded%pot)
            ALLOCATE (nonbond1_atom(nkind), nonbond2_atom(nkind))
            nonbond1_atom = .FALSE.
            nonbond2_atom = .FALSE.
            DO ingp = 1, ngp
               DO ikind = 1, nkind
                  rcut = SQRT(dft_control%qs_control%xtb_control%nonbonded%pot(ingp)%pot%rcutsq)
                  c_radius = rcut
                  CALL get_atomic_kind(atomic_kind_set(ikind), element_symbol=element_symbol)
                  CALL uppercase(element_symbol)
                  IF (TRIM(dft_control%qs_control%xtb_control%nonbonded%pot(ingp)%pot%at1) == TRIM(element_symbol)) THEN
                     nonbond1_atom(ikind) = .TRUE.
                     DO jkind = 1, nkind
                        CALL get_atomic_kind(atomic_kind_set(jkind), element_symbol=element_symbol2)
                        CALL uppercase(element_symbol2)
                        IF (TRIM(dft_control%qs_control%xtb_control%nonbonded%pot(ingp)%pot%at2) == TRIM(element_symbol2)) THEN
                           nonbond2_atom(jkind) = .TRUE.
                        END IF
                     END DO
                  END IF
               END DO
               CALL pair_radius_setup(nonbond1_atom, nonbond2_atom, c_radius, c_radius, pair_radius)
               CALL build_neighbor_lists(sab_xtb_nonbond, particle_set, atom2d, cell, pair_radius, &
                                         symmetric=.FALSE., subcells=subcells, operator_type="PP", nlname="sab_xtb_nonbond")
               CALL set_ks_env(ks_env=ks_env, sab_xtb_nonbond=sab_xtb_nonbond)
               CALL write_neighbor_lists(sab_xtb_nonbond, particle_set, cell, para_env, neighbor_list_section, &
                                         "/SAB_XTB_NONBOND", "sab_xtb_nonbond", "XTB NONBONDED INTERACTIONS")
            END DO
         END IF
      END IF

      ! Build the neighbor lists for the vdW pair potential
      CALL get_qs_env(qs_env=qs_env, dispersion_env=dispersion_env)
      sab_vdw => dispersion_env%sab_vdw
      sab_cn => dispersion_env%sab_cn
      IF (dispersion_env%type == xc_vdw_fun_pairpot .OR. xtb) THEN
         c_radius(:) = dispersion_env%rc_disp
         default_present = .TRUE. !include all atoms in vdW (even without basis)
         CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
         CALL build_neighbor_lists(sab_vdw, particle_set, atom2d, cell, pair_radius, &
                                   subcells=subcells, operator_type="PP", nlname="sab_vdw")
         dispersion_env%sab_vdw => sab_vdw

         IF (xtb .OR. dispersion_env%pp_type == vdw_pairpot_dftd3 .OR. &
             dispersion_env%pp_type == vdw_pairpot_dftd3bj) THEN
            ! Build the neighbor lists for coordination numbers as needed by the DFT-D3 method
            ! This is also needed for the xTB Hamiltonian
            DO ikind = 1, nkind
               CALL get_atomic_kind(atomic_kind_set(ikind), z=zat)
               c_radius(ikind) = 4._dp*ptable(zat)%covalent_radius*bohr
            END DO
            CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
            CALL build_neighbor_lists(sab_cn, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="PP", nlname="sab_cn")
            dispersion_env%sab_cn => sab_cn
         END IF
      END IF

      ! Build the neighbor lists for the gCP pair potential
      NULLIFY (gcp_env)
      CALL get_qs_env(qs_env=qs_env, gcp_env=gcp_env)
      IF (ASSOCIATED(gcp_env)) THEN
         IF (gcp_env%do_gcp) THEN
            sab_gcp => gcp_env%sab_gcp
            DO ikind = 1, nkind
               c_radius(ikind) = gcp_env%gcp_kind(ikind)%rcsto
            END DO
            CALL pair_radius_setup(orb_present, orb_present, c_radius, c_radius, pair_radius)
            CALL build_neighbor_lists(sab_gcp, particle_set, atom2d, cell, pair_radius, &
                                      subcells=subcells, operator_type="PP", nlname="sab_gcp")
            gcp_env%sab_gcp => sab_gcp
         ELSE
            NULLIFY (gcp_env%sab_gcp)
         END IF
      END IF

      IF (lrigpw .OR. lri_optbas) THEN
         ! set neighborlists in lri_env environment
         CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
         soo_list => qs_env%lri_env%soo_list
         CALL build_neighbor_lists(soo_list, particle_set, atom2d, cell, pair_radius, &
                                   mic=mic, molecular=molecule_only, subcells=subcells, nlname="soo_list")
         qs_env%lri_env%soo_list => soo_list
         CALL write_neighbor_lists(soo_list, particle_set, cell, para_env, neighbor_list_section, &
                                   "/SOO_LIST", "soo_list", "ORBITAL ORBITAL (RI)")
      ELSEIF (rigpw) THEN
         ALLOCATE (ri_present(nkind), ri_radius(nkind))
         ri_present = .FALSE.
         ri_radius = 0.0_dp
         DO ikind = 1, nkind
            CALL get_qs_kind(qs_kind_set(ikind), basis_set=ri_basis_set, basis_type="RI_HXC")
            IF (ASSOCIATED(ri_basis_set)) THEN
               ri_present(ikind) = .TRUE.
               CALL get_gto_basis_set(gto_basis_set=ri_basis_set, kind_radius=ri_radius(ikind))
            ELSE
               ri_present(ikind) = .FALSE.
            END IF
         END DO
         ! set neighborlists in lri_env environment
         CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius)
         soo_list => qs_env%lri_env%soo_list
         CALL build_neighbor_lists(soo_list, particle_set, atom2d, cell, pair_radius, &
                                   mic=mic, molecular=molecule_only, subcells=subcells, nlname="soo_list")
         qs_env%lri_env%soo_list => soo_list
         !
         CALL pair_radius_setup(ri_present, ri_present, ri_radius, ri_radius, pair_radius)
         saa_list => qs_env%lri_env%saa_list
         CALL build_neighbor_lists(saa_list, particle_set, atom2d, cell, pair_radius, &
                                   mic=mic, molecular=molecule_only, subcells=subcells, nlname="saa_list")
         qs_env%lri_env%saa_list => saa_list
         !
         CALL pair_radius_setup(ri_present, orb_present, ri_radius, orb_radius, pair_radius)
         soa_list => qs_env%lri_env%soa_list
         CALL build_neighbor_lists(soa_list, particle_set, atom2d, cell, pair_radius, &
                                   mic=mic, symmetric=.FALSE., molecular=molecule_only, &
                                   subcells=subcells, operator_type="ABC", nlname="saa_list")
         qs_env%lri_env%soa_list => soa_list
      END IF

      ! Build the neighbor lists for the ALMO delocalization
      IF (almo) THEN
         DO ikind = 1, nkind
            CALL get_atomic_kind(atomic_kind_set(ikind), rcov=almo_rcov, rvdw=almo_rvdw)
            ! multiply the radius by some hard-coded number
            c_radius(ikind) = MAX(almo_rcov, almo_rvdw)*bohr* &
                              almo_max_cutoff_multiplier
         END DO
         default_present = .TRUE. !include all atoms (even without basis)
         CALL pair_radius_setup(default_present, default_present, c_radius, c_radius, pair_radius)
         CALL build_neighbor_lists(sab_almo, particle_set, atom2d, cell, pair_radius, &
                                   subcells=subcells, operator_type="PP", nlname="sab_almo")
         CALL set_ks_env(ks_env=ks_env, sab_almo=sab_almo)
      END IF

      ! Print particle distribution
      print_key_path = "PRINT%DISTRIBUTION"
      IF (BTEST(cp_print_key_should_output(logger%iter_info, force_env_section, &
                                           print_key_path), &
                cp_p_file)) THEN
         iw = cp_print_key_unit_nr(logger=logger, &
                                   basis_section=force_env_section, &
                                   print_key_path=print_key_path, &
                                   extension=".out")
         CALL write_neighbor_distribution(sab_orb, qs_kind_set, iw, para_env)
         CALL cp_print_key_finished_output(unit_nr=iw, &
                                           logger=logger, &
                                           basis_section=force_env_section, &
                                           print_key_path=print_key_path)
      END IF

      ! Release work storage
      CALL atom2d_cleanup(atom2d)

      DEALLOCATE (atom2d)
      DEALLOCATE (orb_present, default_present, core_present)
      DEALLOCATE (orb_radius, aux_fit_radius, c_radius, core_radius)
      DEALLOCATE (calpha, zeff)
      DEALLOCATE (pair_radius)
      IF (gth_potential_present .OR. sgp_potential_present) THEN
         DEALLOCATE (ppl_present, ppl_radius)
         DEALLOCATE (ppnl_present, ppnl_radius)
      END IF
      IF (paw_atom_present) THEN
         DEALLOCATE (oce_present, oce_radius)
      END IF
      IF (all_potential_present .OR. sgp_potential_present) THEN
         DEALLOCATE (all_present, all_pot_rad)
      END IF

      CALL timestop(handle)

   END SUBROUTINE build_qs_neighbor_lists

! **************************************************************************************************
!> \brief   Build simple pair neighbor lists.
!> \param ab_list ...
!> \param particle_set ...
!> \param atom ...
!> \param cell ...
!> \param pair_radius ...
!> \param subcells ...
!> \param mic ...
!> \param symmetric ...
!> \param molecular ...
!> \param subset_of_mol ...
!> \param current_subset ...
!> \param operator_type ...
!> \param nlname ...
!> \param atomb_to_keep the list of atom indices to keep for pairs from the atom2d%b_list
!> \date    20.03.2002
!> \par History
!>          - Major refactoring (25.07.2010,jhu)
!>          - Added option to filter out atoms from list_b (08.2018, A.  Bussy)
!> \author  MK
!> \version 2.0
! **************************************************************************************************
   SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, subcells, &
                                   mic, symmetric, molecular, subset_of_mol, current_subset, &
                                   operator_type, nlname, atomb_to_keep)

      TYPE(neighbor_list_set_p_type), DIMENSION(:), &
         POINTER                                         :: ab_list
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(local_atoms_type), DIMENSION(:), INTENT(IN)   :: atom
      TYPE(cell_type), POINTER                           :: cell
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pair_radius
      REAL(dp), INTENT(IN)                               :: subcells
      LOGICAL, INTENT(IN), OPTIONAL                      :: mic, symmetric, molecular
      INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: subset_of_mol
      INTEGER, OPTIONAL                                  :: current_subset
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: operator_type
      CHARACTER(LEN=*), INTENT(IN)                       :: nlname
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: atomb_to_keep

      CHARACTER(len=*), PARAMETER :: routineN = 'build_neighbor_lists'

      TYPE local_lists
         INTEGER, DIMENSION(:), POINTER           :: list
      END TYPE local_lists

      INTEGER :: atom_a, atom_b, handle, i, iab, iatom, iatom_local, &
                 iatom_subcell, icell, ikind, j, jatom, jatom_local, jcell, jkind, k, &
                 kcell, maxat, mol_a, mol_b, nkind, otype, natom, inode, nnode, nentry
      INTEGER, DIMENSION(3)                              :: cell_b, ncell, nsubcell, periodic
      INTEGER, DIMENSION(:), POINTER                     :: index_list
      LOGICAL                                            :: include_ab, my_mic, &
                                                            my_molecular, my_symmetric, my_sort_atomb
      LOGICAL, ALLOCATABLE, DIMENSION(:)                 :: pres_a, pres_b
      REAL(dp)                                           :: rab2, rab2_max, rab_max, rabm, deth, subcell_scale
      REAL(dp), DIMENSION(3)                             :: r, rab, ra, rb, sab_max, sb, &
                                                            sb_pbc, sb_min, sb_max, rab_pbc, pd, sab_max_guard
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: nlista, nlistb
      TYPE(local_lists), DIMENSION(:), POINTER           :: lista, listb
      TYPE(neighbor_list_p_type), &
         ALLOCATABLE, DIMENSION(:)                       :: kind_a
      TYPE(neighbor_list_set_type), POINTER              :: neighbor_list_set
      TYPE(subcell_type), DIMENSION(:, :, :), &
         POINTER                                         :: subcell
      REAL(KIND=dp), DIMENSION(:, :), ALLOCATABLE        :: r_pbc
      TYPE(neighbor_list_iterator_p_type), &
         DIMENSION(:), POINTER                           :: nl_iterator

      CALL timeset(routineN//"_"//TRIM(nlname), handle)

      ! input options
      my_mic = .FALSE.
      IF (PRESENT(mic)) my_mic = mic
      my_symmetric = .TRUE.
      IF (PRESENT(symmetric)) my_symmetric = symmetric
      my_molecular = .FALSE.
      ! if we have a molecular NL, MIC has to be used
      IF (PRESENT(molecular)) my_molecular = molecular
      ! check for operator types
      IF (PRESENT(operator_type)) THEN
         SELECT CASE (operator_type)
         CASE ("AB")
            otype = 1 ! simple overlap
         CASE ("ABC")
            otype = 2 ! for three center operators
            CPASSERT(.NOT. my_molecular)
            my_symmetric = .FALSE.
         CASE ("ABBA")
            otype = 3 ! for separable nonlocal operators
            my_symmetric = .FALSE.
         CASE ("PP")
            otype = 4 ! simple atomic pair potential list
         CASE default
            CPABORT("")
         END SELECT
      ELSE
         ! default is a simple AB neighbor list
         otype = 1
      END IF
      my_sort_atomb = .FALSE.
      IF (PRESENT(atomb_to_keep)) THEN
         my_sort_atomb = .TRUE.
      END IF

      nkind = SIZE(atom)
      ! Deallocate the old neighbor list structure
      CALL release_neighbor_list_sets(ab_list)
      ! Allocate and initialize the new neighbor list structure
      ALLOCATE (ab_list(nkind*nkind))
      DO iab = 1, SIZE(ab_list)
         NULLIFY (ab_list(iab)%neighbor_list_set)
         ab_list(iab)%nl_size = -1
         ab_list(iab)%nl_start = -1
         ab_list(iab)%nl_end = -1
         NULLIFY (ab_list(iab)%nlist_task)
      END DO

      ! Allocate and initialize the kind availability
      ALLOCATE (pres_a(nkind), pres_b(nkind))
      DO ikind = 1, nkind
         pres_a(ikind) = ANY(pair_radius(ikind, :) > 0._dp)
         pres_b(ikind) = ANY(pair_radius(:, ikind) > 0._dp)
      END DO

      ! create a copy of the pbc'ed coordinates
      natom = SIZE(particle_set)
      ALLOCATE (r_pbc(3, natom))
      DO i = 1, natom
         r_pbc(1:3, i) = pbc(particle_set(i)%r(1:3), cell)
      END DO

      ! setup the local lists of atoms
      maxat = 0
      DO ikind = 1, nkind
         maxat = MAX(maxat, SIZE(atom(ikind)%list))
      END DO
      ALLOCATE (index_list(maxat))
      DO i = 1, maxat
         index_list(i) = i
      END DO
      ALLOCATE (lista(nkind), listb(nkind), nlista(nkind), nlistb(nkind))
      nlista = 0
      nlistb = 0
      DO ikind = 1, nkind
         NULLIFY (lista(ikind)%list, listb(ikind)%list)
         SELECT CASE (otype)
         CASE (1)
            IF (ASSOCIATED(atom(ikind)%list_local_a_index)) THEN
               lista(ikind)%list => atom(ikind)%list_local_a_index
               nlista(ikind) = SIZE(lista(ikind)%list)
            END IF
            IF (ASSOCIATED(atom(ikind)%list_local_b_index)) THEN
               listb(ikind)%list => atom(ikind)%list_local_b_index
               nlistb(ikind) = SIZE(listb(ikind)%list)
            END IF
         CASE (2)
            IF (ASSOCIATED(atom(ikind)%list_local_a_index)) THEN
               lista(ikind)%list => atom(ikind)%list_local_a_index
               nlista(ikind) = SIZE(lista(ikind)%list)
            END IF
            nlistb(ikind) = SIZE(atom(ikind)%list)
            listb(ikind)%list => index_list
         CASE (3)
            CALL combine_lists(lista(ikind)%list, nlista(ikind), ikind, atom)
            nlistb(ikind) = SIZE(atom(ikind)%list)
            listb(ikind)%list => index_list
         CASE (4)
            nlista(ikind) = SIZE(atom(ikind)%list_1d)
            lista(ikind)%list => atom(ikind)%list_1d
            nlistb(ikind) = SIZE(atom(ikind)%list)
            listb(ikind)%list => index_list
         CASE default
            CPABORT("")
         END SELECT
      END DO

      ! Determine max. number of local atoms
      maxat = 0
      DO ikind = 1, nkind
         maxat = MAX(maxat, nlista(ikind), nlistb(ikind))
      END DO
      ALLOCATE (kind_a(2*maxat))

      ! Load informations about the simulation cell
      CALL get_cell(cell=cell, periodic=periodic, deth=deth)

      ! Loop over all atomic kind pairs
      DO ikind = 1, nkind
         IF (.NOT. pres_a(ikind)) CYCLE

         DO jkind = 1, nkind
            IF (.NOT. pres_b(jkind)) CYCLE

            iab = ikind + nkind*(jkind - 1)

            ! Calculate the square of the maximum interaction distance
            IF (pair_radius(ikind, jkind) <= 0._dp) CYCLE
            rab_max = pair_radius(ikind, jkind)
            IF (otype == 3) THEN
               ! Calculate the square of the maximum interaction distance
               ! for sac_max / ncell this must be the maximum over all kinds
               ! to be correct for three center terms involving different kinds
               rabm = MAXVAL(pair_radius(:, jkind))
            ELSE
               rabm = rab_max
            END IF
            rab2_max = rabm*rabm

            pd(1) = plane_distance(1, 0, 0, cell)
            pd(2) = plane_distance(0, 1, 0, cell)
            pd(3) = plane_distance(0, 0, 1, cell)

            sab_max = rabm/pd
            sab_max_guard = 15.0_dp/pd

            ! It makes sense to have fewer subcells for larger systems
            subcell_scale = ((125.0_dp**3)/deth)**(1.0_dp/6.0_dp)

            ! guess the number of subcells for optimal performance,
            ! guard against crazy stuff triggered by very small rabm
            nsubcell(:) = INT(MAX(1.0_dp, MIN(0.5_dp*subcells*subcell_scale/sab_max(:), &
                                              0.5_dp*subcells*subcell_scale/sab_max_guard(:))))

            ! number of image cells to be considered
            ncell(:) = (INT(sab_max(:)) + 1)*periodic(:)

            CALL allocate_neighbor_list_set(neighbor_list_set=ab_list(iab)%neighbor_list_set, &
                                            symmetric=my_symmetric)
            neighbor_list_set => ab_list(iab)%neighbor_list_set

            DO iatom_local = 1, nlista(ikind)
               iatom = lista(ikind)%list(iatom_local)
               atom_a = atom(ikind)%list(iatom)
               CALL add_neighbor_list(neighbor_list_set=neighbor_list_set, &
                                      atom=atom_a, &
                                      neighbor_list=kind_a(iatom_local)%neighbor_list)
            END DO

            CALL allocate_subcell(subcell, nsubcell)
            DO iatom_local = 1, nlista(ikind)
               iatom = lista(ikind)%list(iatom_local)
               atom_a = atom(ikind)%list(iatom)
               r = r_pbc(:, atom_a)
               CALL give_ijk_subcell(r, i, j, k, cell, nsubcell)
               subcell(i, j, k)%natom = subcell(i, j, k)%natom + 1
            END DO
            DO k = 1, nsubcell(3)
               DO j = 1, nsubcell(2)
                  DO i = 1, nsubcell(1)
                     maxat = subcell(i, j, k)%natom + subcell(i, j, k)%natom/10
                     ALLOCATE (subcell(i, j, k)%atom_list(maxat))
                     subcell(i, j, k)%natom = 0
                  END DO
               END DO
            END DO
            DO iatom_local = 1, nlista(ikind)
               iatom = lista(ikind)%list(iatom_local)
               atom_a = atom(ikind)%list(iatom)
               r = r_pbc(:, atom_a)
               CALL give_ijk_subcell(r, i, j, k, cell, nsubcell)
               subcell(i, j, k)%natom = subcell(i, j, k)%natom + 1
               subcell(i, j, k)%atom_list(subcell(i, j, k)%natom) = iatom_local
            END DO

            DO jatom_local = 1, nlistb(jkind)
               jatom = listb(jkind)%list(jatom_local)
               atom_b = atom(jkind)%list(jatom)
               IF (my_sort_atomb .AND. .NOT. my_symmetric) THEN
                  IF (.NOT. ANY(atomb_to_keep == atom_b)) CYCLE
               END IF
               IF (my_molecular) THEN
                  mol_b = atom(jkind)%list_b_mol(jatom_local)
                  IF (PRESENT(subset_of_mol)) THEN
                     IF (subset_of_mol(mol_b) .NE. current_subset) CYCLE
                  END IF
               END IF
               r = r_pbc(:, atom_b)
               CALL real_to_scaled(sb_pbc(:), r(:), cell)

               loop2_kcell: DO kcell = -ncell(3), ncell(3)
                  sb(3) = sb_pbc(3) + REAL(kcell, dp)
                  sb_min(3) = sb(3) - sab_max(3)
                  sb_max(3) = sb(3) + sab_max(3)
                  IF (periodic(3) /= 0) THEN
                     IF (sb_min(3) >= 0.5_dp) EXIT loop2_kcell
                     IF (sb_max(3) < -0.5_dp) CYCLE loop2_kcell
                  END IF
                  cell_b(3) = kcell

                  loop2_jcell: DO jcell = -ncell(2), ncell(2)
                     sb(2) = sb_pbc(2) + REAL(jcell, dp)
                     sb_min(2) = sb(2) - sab_max(2)
                     sb_max(2) = sb(2) + sab_max(2)
                     IF (periodic(2) /= 0) THEN
                        IF (sb_min(2) >= 0.5_dp) EXIT loop2_jcell
                        IF (sb_max(2) < -0.5_dp) CYCLE loop2_jcell
                     END IF
                     cell_b(2) = jcell

                     loop2_icell: DO icell = -ncell(1), ncell(1)
                        sb(1) = sb_pbc(1) + REAL(icell, dp)
                        sb_min(1) = sb(1) - sab_max(1)
                        sb_max(1) = sb(1) + sab_max(1)
                        IF (periodic(1) /= 0) THEN
                           IF (sb_min(1) >= 0.5_dp) EXIT loop2_icell
                           IF (sb_max(1) < -0.5_dp) CYCLE loop2_icell
                        END IF
                        cell_b(1) = icell

                        CALL scaled_to_real(rb, sb, cell)

                        loop_k: DO k = 1, nsubcell(3)
                           loop_j: DO j = 1, nsubcell(2)
                              loop_i: DO i = 1, nsubcell(1)

                                 ! FIXME for non-periodic systems, the whole subcell trick is skipped
                                 ! yielding a Natom**2 pair list build.
                                 IF (periodic(3) /= 0) THEN
                                    IF (sb_max(3) < subcell(i, j, k)%s_min(3)) EXIT loop_k
                                    IF (sb_min(3) >= subcell(i, j, k)%s_max(3)) CYCLE loop_k
                                 END IF

                                 IF (periodic(2) /= 0) THEN
                                    IF (sb_max(2) < subcell(i, j, k)%s_min(2)) EXIT loop_j
                                    IF (sb_min(2) >= subcell(i, j, k)%s_max(2)) CYCLE loop_j
                                 END IF

                                 IF (periodic(1) /= 0) THEN
                                    IF (sb_max(1) < subcell(i, j, k)%s_min(1)) EXIT loop_i
                                    IF (sb_min(1) >= subcell(i, j, k)%s_max(1)) CYCLE loop_i
                                 END IF

                                 IF (subcell(i, j, k)%natom == 0) CYCLE

                                 DO iatom_subcell = 1, subcell(i, j, k)%natom
                                    iatom_local = subcell(i, j, k)%atom_list(iatom_subcell)
                                    iatom = lista(ikind)%list(iatom_local)
                                    atom_a = atom(ikind)%list(iatom)
                                    IF (my_molecular) THEN
                                       mol_a = atom(ikind)%list_a_mol(iatom_local)
                                       IF (mol_a /= mol_b) CYCLE
                                    END IF
                                    IF (my_symmetric) THEN
                                       IF (atom_a > atom_b) THEN
                                          include_ab = (MODULO(atom_a + atom_b, 2) /= 0)
                                       ELSE
                                          include_ab = (MODULO(atom_a + atom_b, 2) == 0)
                                       END IF
                                       IF (my_sort_atomb) THEN
                                          IF ((.NOT. ANY(atomb_to_keep == atom_b)) .AND. &
                                              (.NOT. ANY(atomb_to_keep == atom_a))) THEN
                                             include_ab = .FALSE.
                                          END IF
                                       END IF
                                    ELSE
                                       include_ab = .TRUE.
                                    END IF
                                    IF (include_ab) THEN
                                       ra(:) = r_pbc(:, atom_a)
                                       rab(:) = rb(:) - ra(:)
                                       rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)
                                       IF (rab2 < rab2_max) THEN
                                          include_ab = .TRUE.
                                          IF (my_mic) THEN
                                             ! only if rab is minimum image the pair will be included
                                             ! ideally the range of the pair list is < L/2 so
                                             ! that this never triggers
                                             rab_pbc(:) = pbc(rab(:), cell)
                                             IF (SUM((rab_pbc - rab)**2) > EPSILON(1.0_dp)) THEN
                                                include_ab = .FALSE.
                                             END IF
                                          END IF
                                          IF (include_ab) THEN
                                             CALL add_neighbor_node( &
                                                neighbor_list=kind_a(iatom_local)%neighbor_list, &
                                                neighbor=atom_b, &
                                                cell=cell_b, &
                                                r=rab, &
                                                nkind=nkind)
                                          END IF
                                       END IF
                                    END IF
                                 END DO

                              END DO loop_i
                           END DO loop_j
                        END DO loop_k

                     END DO loop2_icell
                  END DO loop2_jcell
               END DO loop2_kcell

            END DO

            CALL deallocate_subcell(subcell)

         END DO
      END DO

      SELECT CASE (otype)
      CASE (1:2, 4)
      CASE (3)
         DO ikind = 1, nkind
            DEALLOCATE (lista(ikind)%list)
         END DO
      CASE default
         CPABORT("")
      END SELECT
      DEALLOCATE (kind_a, pres_a, pres_b, lista, listb, nlista, nlistb)
      DEALLOCATE (index_list)
      DEALLOCATE (r_pbc)

      nentry = 0
      CALL neighbor_list_iterator_create(nl_iterator, ab_list)
      DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
         CALL get_iterator_info(nl_iterator, inode=inode, nnode=nnode)
         IF (inode == 1) nentry = nentry + nnode
      END DO
      CALL neighbor_list_iterator_release(nl_iterator)
      !
      ALLOCATE (ab_list(1)%nlist_task(nentry))
      ab_list(1)%nl_size = nentry
      DO iab = 2, SIZE(ab_list)
         ab_list(iab)%nl_size = nentry
         ab_list(iab)%nlist_task => ab_list(1)%nlist_task
      END DO
      !
      nentry = 0
      CALL neighbor_list_iterator_create(nl_iterator, ab_list)
      DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
         nentry = nentry + 1
         CALL get_iterator_task(nl_iterator, ab_list(1)%nlist_task(nentry))
         CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, nkind=nkind)
         iab = (ikind - 1)*nkind + jkind
         IF (ab_list(iab)%nl_start < 0) ab_list(iab)%nl_start = nentry
         IF (ab_list(iab)%nl_end < 0) THEN
            ab_list(iab)%nl_end = nentry
         ELSE
            CPASSERT(ab_list(iab)%nl_end + 1 == nentry)
            ab_list(iab)%nl_end = nentry
         END IF
      END DO
      CALL neighbor_list_iterator_release(nl_iterator)

      CALL timestop(handle)

   END SUBROUTINE build_neighbor_lists

! **************************************************************************************************
!> \brief Build a neighborlist
!> \param ab_list ...
!> \param basis_set_a ...
!> \param basis_set_b ...
!> \param qs_env ...
!> \param mic ...
!> \param symmetric ...
!> \param molecular ...
!> \param operator_type ...
!> \date    14.03.2016
!> \author  JGH
! **************************************************************************************************
   SUBROUTINE setup_neighbor_list(ab_list, basis_set_a, basis_set_b, qs_env, &
                                  mic, symmetric, molecular, operator_type)

      TYPE(neighbor_list_set_p_type), DIMENSION(:), &
         POINTER                                         :: ab_list
      TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER  :: basis_set_a
      TYPE(gto_basis_set_p_type), DIMENSION(:), &
         OPTIONAL, POINTER                               :: basis_set_b
      TYPE(qs_environment_type), POINTER                 :: qs_env
      LOGICAL, INTENT(IN), OPTIONAL                      :: mic, symmetric, molecular
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: operator_type

      CHARACTER(LEN=4)                                   :: otype
      INTEGER                                            :: ikind, nkind
      LOGICAL                                            :: my_mic, my_molecular, my_symmetric
      LOGICAL, ALLOCATABLE, DIMENSION(:)                 :: a_present, b_present
      REAL(dp), ALLOCATABLE, DIMENSION(:)                :: a_radius, b_radius
      REAL(dp), ALLOCATABLE, DIMENSION(:, :)             :: pair_radius
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(cell_type), POINTER                           :: cell
      TYPE(distribution_1d_type), POINTER                :: distribution_1d
      TYPE(distribution_2d_type), POINTER                :: distribution_2d
      TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER  :: basis_a, basis_b
      TYPE(gto_basis_set_type), POINTER                  :: abas, bbas
      TYPE(local_atoms_type), ALLOCATABLE, DIMENSION(:)  :: atom2d
      TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set

      basis_a => basis_set_a
      IF (PRESENT(basis_set_b)) THEN
         basis_b => basis_set_b
         my_symmetric = .FALSE.
      ELSE
         basis_b => basis_set_a
         my_symmetric = .TRUE.
      END IF
      IF (PRESENT(symmetric)) my_symmetric = symmetric

      IF (PRESENT(mic)) THEN
         my_mic = mic
      ELSE
         my_mic = .FALSE.
      END IF

      IF (PRESENT(molecular)) THEN
         my_molecular = molecular
      ELSE
         my_molecular = .FALSE.
      END IF

      IF (PRESENT(operator_type)) THEN
         otype = operator_type
      ELSE
         ! default is a simple AB neighbor list
         otype = "AB"
      END IF

      nkind = SIZE(basis_a)
      ALLOCATE (a_present(nkind), b_present(nkind))
      a_present = .FALSE.
      b_present = .FALSE.
      ALLOCATE (a_radius(nkind), b_radius(nkind))
      a_radius = 0.0_dp
      b_radius = 0.0_dp
      DO ikind = 1, nkind
         IF (ASSOCIATED(basis_a(ikind)%gto_basis_set)) THEN
            a_present(ikind) = .TRUE.
            abas => basis_a(ikind)%gto_basis_set
            CALL get_gto_basis_set(gto_basis_set=abas, kind_radius=a_radius(ikind))
         END IF
         IF (ASSOCIATED(basis_b(ikind)%gto_basis_set)) THEN
            b_present(ikind) = .TRUE.
            bbas => basis_b(ikind)%gto_basis_set
            CALL get_gto_basis_set(gto_basis_set=bbas, kind_radius=b_radius(ikind))
         END IF
      END DO

      ALLOCATE (pair_radius(nkind, nkind))
      pair_radius = 0.0_dp
      CALL pair_radius_setup(a_present, b_present, a_radius, b_radius, pair_radius)

      CALL get_qs_env(qs_env, &
                      atomic_kind_set=atomic_kind_set, &
                      cell=cell, &
                      distribution_2d=distribution_2d, &
                      local_particles=distribution_1d, &
                      particle_set=particle_set, &
                      molecule_set=molecule_set)

      ALLOCATE (atom2d(nkind))
      CALL atom2d_build(atom2d, distribution_1d, distribution_2d, atomic_kind_set, &
                        molecule_set, my_molecular, particle_set=particle_set)
      CALL build_neighbor_lists(ab_list, particle_set, atom2d, cell, pair_radius, &
                                mic=my_mic, symmetric=my_symmetric, molecular=my_molecular, &
                                subcells=2.0_dp, nlname="AUX_NL")

      CALL atom2d_cleanup(atom2d)

      DEALLOCATE (a_present, b_present, a_radius, b_radius, pair_radius, atom2d)

   END SUBROUTINE setup_neighbor_list

! **************************************************************************************************
!> \brief ...
!> \param list ...
!> \param n ...
!> \param ikind ...
!> \param atom ...
! **************************************************************************************************
   SUBROUTINE combine_lists(list, n, ikind, atom)
      INTEGER, DIMENSION(:), POINTER                     :: list
      INTEGER, INTENT(OUT)                               :: n
      INTEGER, INTENT(IN)                                :: ikind
      TYPE(local_atoms_type), DIMENSION(:), INTENT(IN)   :: atom

      INTEGER                                            :: i, ib, na, nb
      INTEGER, DIMENSION(:), POINTER                     :: lista, listb

      CPASSERT(.NOT. ASSOCIATED(list))

      lista => atom(ikind)%list_local_a_index
      listb => atom(ikind)%list_local_b_index

      IF (ASSOCIATED(lista)) THEN
         na = SIZE(lista)
      ELSE
         na = 0
      END IF

      IF (ASSOCIATED(listb)) THEN
         nb = SIZE(listb)
      ELSE
         nb = 0
      END IF

      ALLOCATE (list(na + nb))

      n = na
      IF (na .GT. 0) list(1:na) = lista(1:na)
      IF (nb .GT. 0) THEN
         loopb: DO ib = 1, nb
            DO i = 1, na
               IF (listb(ib) == list(i)) CYCLE loopb
            END DO
            n = n + 1
            list(n) = listb(ib)
         END DO loopb
      END IF
   END SUBROUTINE combine_lists

! **************************************************************************************************

! **************************************************************************************************
!> \brief ...
!> \param present_a ...
!> \param present_b ...
!> \param radius_a ...
!> \param radius_b ...
!> \param pair_radius ...
!> \param prmin ...
! **************************************************************************************************
   SUBROUTINE pair_radius_setup(present_a, present_b, radius_a, radius_b, pair_radius, prmin)
      LOGICAL, DIMENSION(:), INTENT(IN)                  :: present_a, present_b
      REAL(dp), DIMENSION(:), INTENT(IN)                 :: radius_a, radius_b
      REAL(dp), DIMENSION(:, :), INTENT(OUT)             :: pair_radius
      REAL(dp), INTENT(IN), OPTIONAL                     :: prmin

      INTEGER                                            :: i, j, nkind
      REAL(dp)                                           :: rrmin

      nkind = SIZE(present_a)

      pair_radius = 0._dp

      rrmin = 0.0_dp
      IF (PRESENT(prmin)) rrmin = prmin

      DO i = 1, nkind
         IF (.NOT. present_a(i)) CYCLE
         DO j = 1, nkind
            IF (.NOT. present_b(j)) CYCLE
            pair_radius(i, j) = radius_a(i) + radius_b(j)
            pair_radius(i, j) = MAX(pair_radius(i, j), rrmin)
         END DO
      END DO

   END SUBROUTINE pair_radius_setup

! **************************************************************************************************
!> \brief   Print the distribution of the simple pair neighbor list.
!> \param ab ...
!> \param qs_kind_set ...
!> \param output_unit ...
!> \param para_env ...
!> \date    19.06.2003
!> \author  MK
!> \version 1.0
! **************************************************************************************************
   SUBROUTINE write_neighbor_distribution(ab, qs_kind_set, output_unit, para_env)
      TYPE(neighbor_list_set_p_type), DIMENSION(:), &
         POINTER                                         :: ab
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      INTEGER, INTENT(in)                                :: output_unit
      TYPE(mp_para_env_type), POINTER                    :: para_env

      CHARACTER(len=*), PARAMETER :: routineN = 'write_neighbor_distribution'
      LOGICAL, PARAMETER                                 :: full_output = .FALSE.

      INTEGER                                            :: handle, ikind, inode, ipe, jkind, n, &
                                                            nkind, nnode
      INTEGER(int_8)                                     :: nblock_max, nblock_sum, nelement_max, &
                                                            nelement_sum, tmp(2)
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: nblock, nelement, nnsgf
      TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
      TYPE(neighbor_list_iterator_p_type), &
         DIMENSION(:), POINTER                           :: nl_iterator

      CALL timeset(routineN, handle)
      ASSOCIATE (mype => para_env%mepos + 1, npe => para_env%num_pe)

         ! Allocate work storage
         ALLOCATE (nblock(npe), nelement(npe))
         nblock(:) = 0
         nelement(:) = 0
         nkind = SIZE(qs_kind_set)
         ALLOCATE (nnsgf(nkind))
         nnsgf = 1
         DO ikind = 1, nkind
            CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set)
            IF (ASSOCIATED(orb_basis_set)) THEN
               CALL get_gto_basis_set(gto_basis_set=orb_basis_set, nsgf=nnsgf(ikind))
            END IF
         END DO

         CALL neighbor_list_iterator_create(nl_iterator, ab)
         DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
            CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, inode=inode, nnode=nnode)
            IF (inode == 1) THEN
               n = nnsgf(ikind)*nnsgf(jkind)
               nblock(mype) = nblock(mype) + nnode
               nelement(mype) = nelement(mype) + n*nnode
            END IF
         END DO
         CALL neighbor_list_iterator_release(nl_iterator)

         IF (full_output) THEN
            ! XXXXXXXX should gather/scatter this on ionode
            CALL para_env%sum(nblock)
            CALL para_env%sum(nelement)

            nblock_sum = SUM(INT(nblock, KIND=int_8))
            nelement_sum = SUM(INT(nelement, KIND=int_8))
         ELSE
            nblock_sum = nblock(mype)
            nblock_max = nblock(mype)
            nelement_sum = nelement(mype)
            nelement_max = nelement(mype)
            tmp = (/nblock_sum, nelement_sum/)
            CALL para_env%sum(tmp)
            nblock_sum = tmp(1); nelement_sum = tmp(2)
            tmp = (/nblock_max, nelement_max/)
            CALL para_env%max(tmp)
            nblock_max = tmp(1); nelement_max = tmp(2)
         END IF

         IF (output_unit > 0) THEN
            IF (full_output) THEN
               WRITE (UNIT=output_unit, &
                      FMT="(/,/,T2,A,/,/,T3,A,/,/,(T4,I6,T27,I10,T55,I10))") &
                  "DISTRIBUTION OF THE NEIGHBOR LISTS", &
                  "Process   Number of particle pairs   Number of matrix elements", &
                  (ipe - 1, nblock(ipe), nelement(ipe), ipe=1, npe)
               WRITE (UNIT=output_unit, FMT="(/,T7,A3,T27,I10,T55,I10)") &
                  "Sum", SUM(nblock), SUM(nelement)
            ELSE
               WRITE (UNIT=output_unit, FMT="(/,T2,A)") "DISTRIBUTION OF THE NEIGHBOR LISTS"
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Total number of particle pairs:", nblock_sum
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Total number of matrix elements:", nelement_sum
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of particle pairs:", (nblock_sum + npe - 1)/npe
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of particle pairs:", nblock_max
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of matrix element:", (nelement_sum + npe - 1)/npe
               WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of matrix elements:", nelement_max
            END IF
         END IF
      END ASSOCIATE

      ! Release work storage

      DEALLOCATE (nblock, nelement, nnsgf)

      CALL timestop(handle)

   END SUBROUTINE write_neighbor_distribution

! **************************************************************************************************
!> \brief   Write a set of neighbor lists to the output unit.
!> \param ab ...
!> \param particle_set ...
!> \param cell ...
!> \param para_env ...
!> \param neighbor_list_section ...
!> \param nl_type ...
!> \param middle_name ...
!> \param nlname ...
!> \date    04.03.2002
!> \par History
!>       - Adapted to the new parallelized neighbor list version
!>         (26.06.2003,MK)
!> \author  MK
!> \version 1.0
! **************************************************************************************************
   SUBROUTINE write_neighbor_lists(ab, particle_set, cell, para_env, neighbor_list_section, &
                                   nl_type, middle_name, nlname)

      TYPE(neighbor_list_set_p_type), DIMENSION(:), &
         POINTER                                         :: ab
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(cell_type), POINTER                           :: cell
      TYPE(mp_para_env_type), POINTER                    :: para_env
      TYPE(section_vals_type), POINTER                   :: neighbor_list_section
      CHARACTER(LEN=*), INTENT(IN)                       :: nl_type, middle_name, nlname

      CHARACTER(LEN=default_string_length)               :: string, unit_str
      INTEGER                                            :: iatom, inode, iw, jatom, nneighbor, nnode
      INTEGER, DIMENSION(3)                              :: cell_b
      REAL(dp)                                           :: dab, unit_conv
      REAL(dp), DIMENSION(3)                             :: ra, rab, rb
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(neighbor_list_iterator_p_type), &
         DIMENSION(:), POINTER                           :: nl_iterator

      NULLIFY (logger)
      logger => cp_get_default_logger()
      IF (BTEST(cp_print_key_should_output(logger%iter_info, neighbor_list_section, &
                                           TRIM(nl_type)), &
                cp_p_file)) THEN
         iw = cp_print_key_unit_nr(logger=logger, &
                                   basis_section=neighbor_list_section, &
                                   print_key_path=TRIM(nl_type), &
                                   extension=".out", &
                                   middle_name=TRIM(middle_name), &
                                   local=.TRUE., &
                                   log_filename=.FALSE., &
                                   file_position="REWIND")
         ASSOCIATE (mype => para_env%mepos)
            CALL section_vals_val_get(neighbor_list_section, "UNIT", c_val=unit_str)
            unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str))

            ! Print headline
            string = ""
            WRITE (UNIT=string, FMT="(A,I5,A)") &
               TRIM(nlname)//" IN "//TRIM(unit_str)//" (PROCESS", mype, ")"
            CALL compress(string)
            IF (iw > 0) WRITE (UNIT=iw, FMT="(/,/,T2,A)") TRIM(string)

            nneighbor = 0

            CALL neighbor_list_iterator_create(nl_iterator, ab)
            DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
               CALL get_iterator_info(nl_iterator, inode=inode, nnode=nnode, &
                                      iatom=iatom, jatom=jatom, cell=cell_b, r=rab)
               nneighbor = nneighbor + 1
               ra(:) = pbc(particle_set(iatom)%r, cell)
               rb(:) = ra(:) + rab(:)
               dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3))
               IF (iw > 0) THEN
                  IF (inode == 1) THEN
                     WRITE (UNIT=iw, FMT="(/,T2,I5,3X,I6,3X,3F12.6)") &
                        iatom, nnode, ra(1:3)*unit_conv
                  END IF
                  WRITE (UNIT=iw, FMT="(T10,I6,3X,3I4,3F12.6,2X,F12.6)") &
                     jatom, cell_b(1:3), rb(1:3)*unit_conv, dab*unit_conv
               END IF
            END DO
            CALL neighbor_list_iterator_release(nl_iterator)

            string = ""
            WRITE (UNIT=string, FMT="(A,I12,A,I12)") &
               "Total number of neighbor interactions for process", mype, ":", &
               nneighbor
            CALL compress(string)
            IF (iw > 0) WRITE (UNIT=iw, FMT="(/,T2,A)") TRIM(string)
            CALL cp_print_key_finished_output(unit_nr=iw, &
                                              logger=logger, &
                                              basis_section=neighbor_list_section, &
                                              print_key_path=TRIM(nl_type), &
                                              local=.TRUE.)
         END ASSOCIATE
      END IF

   END SUBROUTINE write_neighbor_lists

END MODULE qs_neighbor_lists
